home *** CD-ROM | disk | FTP | other *** search
/ Clickx 115 / Clickx 115.iso / software / tools / windows / tails-i386-0.16.iso / live / filesystem.squashfs / usr / lib / gnupg / gpgkeys_hkpms < prev    next >
Encoding:
Text File  |  2010-12-20  |  10.8 KB  |  290 lines
  1. #!/usr/bin/perl -w
  2.  
  3. # hkpms transport -- HKP-over-TLS, authenticated by monkeysphere
  4.  
  5. use strict;
  6. use warnings;
  7.  
  8.  
  9.  
  10. # Author: Daniel Kahn Gillmor <dkg@fifthhorseman.net>
  11. # Copyright: 2010
  12. # License: GPL v3+
  13. #          (you should have received a COPYING file with this distribution)
  14.  
  15.  
  16.  
  17.  
  18. { package Crypt::Monkeysphere::MSVA::HKPMS;
  19.   use POSIX;
  20.   use Crypt::Monkeysphere::MSVA::Logger;
  21.   use Crypt::Monkeysphere::MSVA::Client;
  22.   use Regexp::Common qw /net/;
  23.   use Module::Load::Conditional;
  24.  
  25.   sub parse_input {
  26.     my $self = shift;
  27.     my $input = shift;
  28.  
  29.     my $inheaders = 1;
  30.     foreach my $line (split(/\n/, $input)) {
  31.       if ($inheaders) {
  32.         if ($line eq '') {
  33.           $inheaders = 0;
  34.         } else {
  35.           next if ($line =~ /^#/);
  36.           my @args = split(/ /, $line);
  37.           my $cmd = shift @args;
  38.           $self->{config}->{lc($cmd)} = join(' ', @args);
  39.           if (lc($cmd) eq 'option') {
  40.             my $opt = lc($args[0]);
  41.             if ($opt eq 'debug') {
  42.               $self->{logger}->set_log_level('debug');
  43.             } elsif ($opt eq 'verbose') {
  44.               $self->{logger}->more_verbose();
  45.             } elsif ($opt eq 'no-check-cert') {
  46.               $self->{logger}->log('error', "Received no-check-cert option.  Why are you bothering with hkpms if you aren't checking?\n");
  47.               $self->{actually_check} = 0;
  48.             } elsif ($opt eq 'check-cert') {
  49.               $self->{actually_check} = 1;
  50.             } elsif ($opt =~ /^http-proxy=(.*)/) {
  51.               my $hp = $1;
  52.               if ($hp =~ /^(socks|http|https):\/\/($RE{net}{domain}|$RE{net}{IPv4}):([[:digit:]]+)\/?$/) {
  53.                 if ('socks' eq $1) {
  54.                   if ( ! Module::Load::Conditional::check_install(module => 'LWP::Protocol::socks')) {
  55.                     $self->{logger}->log('error', "Requesting a socks proxy for hkpms, but LWP::Protocol::socks is not installed.\nThis will likely fail.\n");
  56.                   }
  57.                 }
  58.                 $self->{proxy} = sprintf('%s://%s:%s', $1, $2, $3);
  59.               } else {
  60.                 $self->{logger}->log('error', "Failed to make sense of this http-proxy address: '%s'; ignoring.\n", $hp);
  61.               }
  62.             } else {
  63.               $self->{logger}->log('error', "Received '%s' as an option, but gpgkeys_hkpms does not implement it. Ignoring...\n", $opt);
  64.             }
  65.             # FIXME: consider other keyserver-options from gpg(1).
  66.             # in particular, the following might be interesting:
  67.             # timeout
  68.             # include-revoked
  69.             # include-disabled
  70.             # ca-cert-file
  71.           }
  72.         }
  73.       } else {
  74.         push(@{$self->{args}}, $line);
  75.       }
  76.     }
  77.   }
  78.  
  79.   sub verify_cert {
  80.     my $self = shift;
  81.     my ($ok, $ctxstore, $certname, $error, $cert) = @_;
  82.     my $certpem = Net::SSLeay::PEM_get_string_X509($cert);
  83.     my ($status, $ret);
  84.  
  85.     if (exists $self->{cache}->{$certpem}) {
  86.       ($status, $ret) = @{$self->{cache}->{$certpem}};
  87.       $self->{logger}->log('debug', "Found response in cache\n");
  88.     } else {
  89.       # use Crypt::Monkeysphere::MSVA::Client if available:
  90.       if (defined($self->{client})) {
  91.         # because we really don't want to create some sort of MSVA loop:
  92.         ($status, $ret) = $self->{client}->query_agent('https', $self->{config}->{host}, 'server', 'x509pem', $certpem, 'never');
  93.       } else {
  94.         use Crypt::Monkeysphere::MSVA;
  95.         $self->{logger}->log('verbose', "Could not find a running agent (MONKEYSPHERE_VALIDATION_AGENT_SOCKET env var).\nFalling back to in-process certificate checks.\n");
  96.         # If there is no running agent, we might want to be able to fall
  97.         # back here.
  98.  
  99.         # FIXME: this is hackery!  we're just calling daemon-internal code
  100.         # (and it's not a stable API):
  101.  
  102.         my $data = {peer => { name => $self->{config}->{host}, type => 'server' },
  103.                     context => 'https',
  104.                     pkc => { type => 'x509pem', data => $certpem },
  105.                     keyserverpolicy => 'never', # because we really don't want to create some sort of MSVA loop
  106.                    };
  107.  
  108.         my $clientinfo = { uid => POSIX::geteuid(), inode => undef };
  109.  
  110.         ($status, $ret) = Crypt::Monkeysphere::MSVA::reviewcert($data, $clientinfo);
  111.       }
  112.  
  113.       # make a cache of the cert if it verifies once, since this seems
  114.       # to get called 3 times by perl for some reason. (see
  115.       # https://bugs.debian.org/606249)
  116.       $self->{cache}->{$certpem} = [ $status, $ret ];
  117.       if (JSON::is_bool($ret->{valid}) && ($ret->{valid} eq 1)) {
  118.         $self->{logger}->log('verbose', "Monkeysphere HKPMS Certificate validation succeeded:\n  %s\n", $ret->{message});
  119.       } else {
  120.         $self->{logger}->log('error', "Monkeysphere HKPMS Certificate validation failed:\n  %s\n", $ret->{message});
  121.       }
  122.     }
  123.  
  124.     if (JSON::is_bool($ret->{valid}) && ($ret->{valid} eq 1)) {
  125.       return 1;
  126.     } else {
  127.       return 0;
  128.     }
  129.   }
  130.  
  131.   sub query {
  132.     my $self = shift;
  133.  
  134.     # FIXME: i'd like to pass this debug argument to IO::Socket::SSL,
  135.     # but i don't know how to do that.
  136.     # i get 'Variable "@iosslargs" will not stay shared' if i try to call
  137.     # use IO::Socket::SSL 1.37 @iosslargs;
  138.     my @iosslargs = ();
  139.     if ($self->{logger}->get_log_level() >= 4) {
  140.       push @iosslargs, sprintf("debug%d", int($self->{logger}->get_log_level() - 3));
  141.     }
  142.  
  143.     # versions earlier than 1.35 can fail open: bad news!.
  144.     # 1.37 lets us set ca_path and ca_file to undef, which is what we want.
  145.     use IO::Socket::SSL 1.37;
  146.     use Net::SSLeay;
  147.     use LWP::UserAgent;
  148.     use URI;
  149.  
  150.     IO::Socket::SSL::set_ctx_defaults(
  151.                                       verify_callback => sub { $self->verify_cert(@_); },
  152.                                       verify_mode => 0x03,
  153.                                       ca_path => undef,
  154.                                       ca_file => undef,
  155.                                      );
  156.  
  157.     my $ua = LWP::UserAgent::->new();
  158.  
  159.     if (exists($self->{proxy})) {
  160.       $self->{logger}->log('verbose', "Using http-proxy: %s\n", $self->{proxy});
  161.       $ua->proxy([qw(http https)] => $self->{proxy});
  162.     } else {
  163.       # if no proxy was explicitly set, use the environment:
  164.       $ua->env_proxy();
  165.     }
  166.  
  167.     printf("VERSION 1\nPROGRAM %s gpgkeys_hkpms msva-perl/%s\n",
  168.            $self->{config}->{program},  # this is kind of cheating :/
  169.            $Crypt::Monkeysphere::MSVA::VERSION);
  170.  
  171.  
  172.     $self->{logger}->log('debug', "command: %s\n", $self->{config}->{command});
  173.     if (lc($self->{config}->{command}) eq 'search') {
  174.       # for COMMAND = SEARCH, we want op=index, and we want to rejoin all args with spaces.
  175.       my $uri = URI::->new(sprintf('https://%s/pks/lookup', $self->{config}->{host}));
  176.       my $arg = join(' ', @{$self->{args}});
  177.       $uri->query_form(op => 'index',
  178.                        options => 'mr',
  179.                        search => $arg,
  180.                       );
  181.       $arg =~ s/\n/ /g ; # swap out newlines for spaces
  182.       printf("\n%s %s BEGIN\n", $self->{config}->{command}, $arg);
  183.       $self->{logger}->log('debug', "URI: %s\n", $uri);
  184.       my $resp = $ua->get($uri);
  185.       if ($resp->is_success) {
  186.         print($resp->decoded_content);
  187.       } else {
  188.         # FIXME: handle errors better
  189.         $self->{logger}->log('error', "HTTPS error: %s\n", $resp->status_line);
  190.       }
  191.       printf("\n%s %s END\n", $self->{config}->{command}, $arg);
  192.     } elsif (lc($self->{config}->{command}) eq 'get') {
  193.       # for COMMAND = GET, we want op=get, and we want to issue each query separately.
  194.       my $uri = URI::->new(sprintf('https://%s/pks/lookup', $self->{config}->{host}));
  195.       foreach my $arg (@{$self->{args}}) {
  196.         printf("\n%s %s BEGIN\n", $self->{config}->{command}, $arg);
  197.         $uri->query_form(op => 'get',
  198.                          options => 'mr',
  199.                          search => $arg,
  200.                         );
  201.         my $resp = $ua->get($uri);
  202.         if ($resp->is_success) {
  203.           print($resp->decoded_content);
  204.         } else {
  205.           # FIXME: handle errors better
  206.           $self->{logger}->log('error', "HTTPS error: %s\n", $resp->status_line);
  207.         }
  208.         printf("\n%s %s END\n", $self->{config}->{command}, $arg);
  209.       }
  210.     } elsif (lc($self->{config}->{command}) eq 'send') {
  211.       $self->{logger}->log('debug', "Sending keys");
  212.       # walk the input looking for "KEY E403BC1A17856FB7 BEGIN" lines.
  213.       my @keydata;
  214.       my $keyid;
  215.       foreach my $arg (@{$self->{args}}) {
  216.         if ($arg =~ /^KEY ([a-fA-F0-9]+) BEGIN\s*$/) {
  217.           @keydata = ();
  218.           $keyid = $1;
  219.           $self->{logger}->log('debug', "Found KEY BEGIN line (%s)\n", $keyid);
  220.         } elsif (defined($keyid)) {
  221.           if ($arg eq sprintf('KEY %s END', $keyid)) {
  222.             $self->{logger}->log('debug', "Found KEY END line with %d lines of data elapsed\n", scalar(@keydata));
  223.             # for sending keys, we want to POST to /pks/add, with a keytext variable.
  224.             my $uri = URI::->new(sprintf('https://%s/pks/add', $self->{config}->{host}));
  225.             my $resp = $ua->post($uri, {keytext => join("\n", @keydata)});
  226.             if ($resp->is_success) {
  227.               printf("\n%s", $resp->decoded_content);
  228.             } else {
  229.               # FIXME: handle errors better
  230.               $self->{logger}->log('error', "HTTPS error: %s\n", $resp->status_line);
  231.             }
  232.             printf("\nKEY %s SENT\n", $keyid);
  233.             @keydata = ();
  234.             $keyid = undef;
  235.           } else {
  236.             push @keydata, $arg;
  237.           }
  238.         } else {
  239.           $self->{logger}->log('debug2', "Found garbage line\n");
  240.         }
  241.       }
  242.       if (defined($keyid)) {
  243.         $self->{logger}->log('error', "Never got a 'KEY %s END' line, discarding.\n", $keyid);
  244.       }
  245.     } else {
  246.       # are there other commands we might want?
  247.       $self->{logger}->log('error', "Unknown command %s\n", $self->{config}->{command});
  248.     }
  249.   }
  250.  
  251.  
  252.   sub new {
  253.     my $class = shift;
  254.  
  255.     my $default_log_level = 'error';
  256.     my $client;
  257.     if (exists($ENV{MONKEYSPHERE_VALIDATION_AGENT_SOCKET})) {
  258.       $client = Crypt::Monkeysphere::MSVA::Client::->new(
  259.                                                          socket => $ENV{MONKEYSPHERE_VALIDATION_AGENT_SOCKET},
  260.                                                          log_level => $default_log_level,
  261.                                                         );
  262.     }
  263.     my $self = { config => { },
  264.                  args => [ ],
  265.                  logger => (defined($client) ? $client->{logger} : Crypt::Monkeysphere::MSVA::Logger::->new($default_log_level)),
  266.                  cache => { },
  267.                  client => $client,
  268.                  actually_check => 1,
  269.                };
  270.  
  271.     bless ($self, $class);
  272.     return $self;
  273.   }
  274.   1;
  275. }
  276.  
  277.  
  278. my $hkpms = Crypt::Monkeysphere::MSVA::HKPMS::->new();
  279.  
  280. my $input = # load gpg instructions from stdin:
  281.   do {
  282.     local $/; # slurp!
  283.     <STDIN>;
  284.   };
  285.  
  286.  
  287. $hkpms->parse_input($input);
  288. $hkpms->query();
  289.  
  290.